home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 February: Tool Chest / Apple Developer CD Series Tool Chest February 1996 (Apple Computer)(1996).iso / Tool Chest / Text / WASTE / WASTE 1.1.2 Distribution / Demo Source / LongControls.p < prev    next >
Encoding:
Text File  |  1995-10-12  |  5.0 KB  |  205 lines  |  [TEXT/CWIE]
  1. unit LongControls;
  2.  
  3. { WASTE DEMO PROJECT: }
  4. { Macintosh Controls with Long Values }
  5.  
  6. { Copyright © 1993-1995 Marco Piovanelli }
  7. { All Rights Reserved }
  8.  
  9. interface
  10.     uses
  11.         Controls;
  12.  
  13. { creation and destruction }
  14.  
  15.     function LCAttach (control: ControlRef): OSErr;
  16.     procedure LCDetach (control: ControlRef);
  17.  
  18. { setting variables }
  19.  
  20.     procedure LCSetValue (control: ControlRef;
  21.                                     value: LongInt);
  22.     procedure LCSetMin (control: ControlRef;
  23.                                     min: LongInt);
  24.     procedure LCSetMax (control: ControlRef;
  25.                                     max: LongInt);
  26.  
  27. { getting variables }
  28.  
  29.     function LCGetValue (control: ControlRef): LongInt;
  30.     function LCGetMin (control: ControlRef): LongInt;
  31.     function LCGetMax (control: ControlRef): LongInt;
  32.  
  33. { synchronizing long settings with control (short) settings }
  34.  
  35.     procedure LCSynch (control: ControlRef);
  36.  
  37. implementation
  38.     uses
  39.         FixMath, ToolUtils;
  40.  
  41. { LongControls private constants and data types }
  42.  
  43.     const
  44.  
  45.         kMaxShort = $7FFF;            { maximum signed short integer }
  46.         kMinShort = $8000;            { minimum signed short integer }
  47.  
  48.     type
  49.  
  50. { long control auxiliary record used for keeping long settings }
  51. { a handle to this record is stored in the reference field of the control record }
  52.  
  53.         LCAuxRec = record
  54.                 value: LongInt;                { long value }
  55.                 min: LongInt;                { long min }
  56.                 max: LongInt;                { long max }
  57.             end;  { LCAuxRec }
  58.         LCAuxPtr = ^LCAuxRec;
  59.         LCAuxHandle = ^LCAuxPtr;
  60.  
  61.     function LCAttach (control: ControlRef): OSErr;
  62.         var
  63.             aux: Handle;
  64.             pAux: LCAuxPtr;
  65.     begin
  66.         LCAttach := noErr;
  67.  
  68. { allocate the auxiliary record that will hold long settings }
  69.         aux := NewHandleClear(SizeOf(LCAuxRec));
  70.         if (aux = nil) then
  71.             begin
  72.                 LCAttach := MemError;
  73.                 Exit(LCAttach);
  74.             end;
  75.  
  76. { store a handle to the auxiliary record in the reference field }
  77.         SetControlReference(control, LongInt(aux));
  78.  
  79. { copy current control settings into the auxiliary record }
  80.         pAux := LCAuxHandle(aux)^;
  81.         pAux^.value := GetControlValue(control);
  82.         pAux^.min := GetControlMinimum(control);
  83.         pAux^.max := GetControlMaximum(control);
  84.  
  85.     end;  { LCAttach }
  86.  
  87.     procedure LCDetach (control: ControlRef);
  88.         var
  89.             aux: Handle;
  90.     begin
  91.         aux := Handle(GetControlReference(control));
  92.         if (aux <> nil) then
  93.             begin
  94.                 SetControlReference(control, 0);
  95.                 DisposeHandle(aux);
  96.             end
  97.     end;  { LCDispose }
  98.  
  99.     procedure LCSetValue (control: ControlRef;
  100.                                     value: LongInt);
  101.         var
  102.             pAux: LCAuxPtr;
  103.             controlMin, controlMax, newControlValue: Integer;
  104.     begin
  105.         pAux := LCAuxHandle(GetControlReference(control))^;
  106.  
  107. { make sure value is in the range min..max }
  108.         if (value < pAux^.min) then
  109.             value := pAux^.min;
  110.         if (value > pAux^.max) then
  111.             value := pAux^.max;
  112.  
  113. { save value in auxiliary record }
  114.         pAux^.value := value;
  115.  
  116. { calculate new thumb position }
  117.         controlMin := GetControlMinimum(control);
  118.         controlMax := GetControlMaximum(control);
  119.         newControlValue := controlMin + FixRound(FixMul(FixDiv(value - pAux^.min, pAux^.max - pAux^.min), BSL(controlMax - controlMin, 16)));
  120.  
  121. { do nothing if the thumb position hasn't changed }
  122.         if (newControlValue <> GetControlValue(control)) then
  123.             SetControlValue(control, newControlValue);
  124.  
  125.     end;  { LCSetValue }
  126.  
  127.     procedure LCSetMin (control: ControlRef;
  128.                                     min: LongInt);
  129.         var
  130.             pAux: LCAuxPtr;
  131.     begin
  132.         pAux := LCAuxHandle(GetControlReference(control))^;
  133.  
  134. { make sure min is less than or equal to max }
  135.         if (min > pAux^.max) then
  136.             min := pAux^.max;
  137.  
  138. { save min in auxiliary record }
  139.         pAux^.min := min;
  140.  
  141. { set contrlMin field to min or kMinShort, whichever is greater }
  142.         if (min < kMinShort) then
  143.             min := kMinShort;
  144.         SetControlMinimum(control, min);
  145.  
  146. { reset value }
  147.         LCSetValue(control, pAux^.value);
  148.  
  149.     end;  { LCSetMin }
  150.  
  151.     procedure LCSetMax (control: ControlRef;
  152.                                     max: LongInt);
  153.         var
  154.             pAux: LCAuxPtr;
  155.     begin
  156.         pAux := LCAuxHandle(GetControlReference(control))^;
  157.  
  158. { make sure max is greater than or equal to min }
  159.         if (max < pAux^.min) then
  160.             max := pAux^.min;
  161.  
  162. { save max in auxiliary record }
  163.         pAux^.max := max;
  164.  
  165. { set contrlMax field to max or kMaxShort, whichever is less }
  166.         if (max > kMaxShort) then
  167.             max := kMaxShort;
  168.         SetControlMaximum(control, max);
  169.  
  170. { reset value }
  171.         LCSetValue(control, pAux^.value);
  172.  
  173.     end;  { LCSetMax }
  174.  
  175.     function LCGetValue (control: ControlRef): LongInt;
  176.     begin
  177.         LCGetValue := LCAuxHandle(GetControlReference(control))^^.value;
  178.     end;  { LCGetValue }
  179.  
  180.     function LCGetMin (control: ControlRef): LongInt;
  181.     begin
  182.         LCGetMin := LCAuxHandle(GetControlReference(control))^^.min;
  183.     end;  { LCGetMin }
  184.  
  185.     function LCGetMax (control: ControlRef): LongInt;
  186.     begin
  187.         LCGetMax := LCAuxHandle(GetControlReference(control))^^.max;
  188.     end;  { LCGetMax }
  189.  
  190.     procedure LCSynch (control: ControlRef);
  191.         var
  192.             controlMin, controlMax, controlValue: Integer;
  193.             pAux: LCAuxPtr;
  194.     begin
  195.         controlMin := GetControlMinimum(control);
  196.         controlMax := GetControlMaximum(control);
  197.         controlValue := GetControlValue(control);
  198.         pAux := LCAuxHandle(GetControlReference(control))^;
  199.  
  200. { calculate new long value }
  201.         pAux^.value := pAux^.min + FixMul(FixRatio(controlValue - controlMin, controlMax - controlMin), pAux^.max - pAux^.min);
  202.  
  203.     end;  { LCSynch }
  204.  
  205. end.